home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / fract3a.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-06-22  |  1.5 KB  |  57 lines
  1.  
  2. {$g+,n+,e-}
  3.  
  4. { Reals   :       -1     -0.1      0.3   -1.139
  5.   Complex :        0      0.8     -0.5    0.238 }
  6.  
  7. program Julia;
  8. { Julia Fractal, mode 13h. By Bas van Gaalen, Holland, PD }
  9. uses
  10.   crt;
  11. const
  12.   zoom=-1;
  13.   vidseg:word=$a000;
  14. type
  15.   real=double;
  16. var
  17.   cx,cy,xo,yo,x1,y1:real;
  18.   mx,my,a,b,i,orb:word;
  19.  
  20. procedure setpal(col,r,g,b : byte); assembler; asm
  21.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  22.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  23.  
  24. procedure retrace; assembler; asm
  25.   mov dx,03dah; @vert1: in al,dx; test al,8; jnz @vert1
  26.   @vert2: in al,dx; test al,8; jz @vert2; end;
  27.  
  28. begin
  29.   checkbreak:=true;
  30.   {write('Real part: '); readln(cx);} cx:=0.3;
  31.   {write('Imaginary part: '); readln(cy);} cy:=-0.5;
  32.   asm mov ax,13h; int 10h; end;
  33.   for i:=1 to 64 do setpal(i,10+i div 3,10+i div 3,15+round(i/1.306122449));
  34.   mx:=319; my:=199;
  35.   for a:=0 to mx do
  36.     for b:=0 to my do begin
  37.       if zoom<>-4 then xo:=-2-0.5*zoom+a/(mx/(4+zoom))
  38.       else xo:=-2-0.5*zoom+a/mx; { x complex plane coordinate }
  39.       if zoom<>-4 then yo:=2+0.5*zoom-b/(my/(4+zoom))
  40.       else yo:=2+0.5*zoom-b/my; { y complex plane coordinate }
  41.       orb:=0; i:=0;
  42.       repeat
  43.         x1:=xo*xo-yo*yo+cx;
  44.         y1:=2*xo*yo+cy;
  45.         xo:=x1;
  46.         yo:=y1;
  47.         inc(i);
  48.       until (i=64) or (x1*x1+y1*y1>4) or (abs(x1)>2) or (abs(y1)>2);
  49.       if i<>64 then orb:=i;
  50.       mem[vidseg:b*320+a]:=orb; { Plot orbit }
  51.     end;
  52.  
  53.   while not keypressed do;
  54.   while keypressed do readkey;
  55.   textmode(lastmode);
  56. end.
  57.